with Ada.Unchecked_Conversion;
with Ada.Exceptions;
with Interfaces.C;

package body win32api_interface.memory is

  function null_string (l : in integer) return string is
    result : string (1..l);
  begin
    for i in 1..result'last loop
      result(i) := character'val(0);
    end loop;
    return result;
  end null_string;

  -------------------------
  -- Read_Process_Memory --
  -------------------------

  function Read_Process_Memory(Handle: in Win32.Winnt.HANDLE;
                               Target: in Address;
                               Length: in Integer) return string is
    use Interfaces.C;
    ReadOk : Win32.BOOL;

    type buffering is new string(1..Length);
    type pBuffer is access all buffering; --p is from "pointer".
    Buff: aliased buffering;
    pBuff: constant pBuffer:= Buff'access;
    function pBuffer_to_Address is new
      Ada.Unchecked_Conversion
        (source => pBuffer,
         target => System.Address);

    type DWORD is new Interfaces.C.unsigned_long;
    type LPDWORD is access all DWORD;
    Read_Bytes : aliased DWORD;
    --type pUnsigned_Long is access all Win32.PDWORD;
    pRead_Bytes : constant LPDWORD := Read_Bytes'access;
    function LPDWORD_to_Address is new
      Ada.Unchecked_Conversion
        (source => LPDWORD,
         target => Win32.PULONG);

    function Target_Pointer_to_Address is new
      Ada.Unchecked_Conversion
        (source => Address,
         target => System.Address);

    function Integer_to_Unsigned_long is new
      Ada.Unchecked_Conversion
        (source => Integer,
         target => Interfaces.C.unsigned_long);


  begin
    ReadOk := Win32.Winbase.ReadProcessMemory(
                Handle,
                Target_Pointer_to_Address(Target),
                --  Target Address to read.
                pBuffer_to_Address(pBuff),
                --  Destination reading buffer.
                Integer_to_Unsigned_long(Length),
                --  Number of Bytes to read.
                LPDWORD_to_Address(pRead_Bytes));
    if integer(ReadOk) = 0 then
      --Put_Line("Req"&Integer'Image(Length)&"Read:"&Integer'Image(Integer(Read_Bytes))); -- Debug!
      if Read_Bytes = 0 then
        Report_Error_Thr("ReadProcessMemory", Get_Last_Error);
        --Report_Error ("ReadProcessMemory");
        --raise Read_Process_Memory_Error;
      else
        Ada.Exceptions.Raise_Exception(Semi_Read_Error'Identity,
                                       "Only some bytes read.");
      end if;
    end if;
    return String(Buff);
  end Read_Process_Memory;

  ----------------------------
  -- Read_Process_Memory_Ex --
  ----------------------------

  function Read_Process_Memory_Ex(Handle: in Win32.Winnt.HANDLE;
                                  Target: in Address;
                                  Length: in Integer) return string is
    ReadOk : Win32.BOOL;

    Buff : aliased string(1..length);

    function Target_Pointer_to_Address is new
      Ada.Unchecked_Conversion
        (source => Address,
         target => System.Address);

    function Integer_to_Unsigned_long is new
      Ada.Unchecked_Conversion
        (source => Integer,
         target => Interfaces.C.unsigned_long);
  begin
    ReadOk := Win32.Winbase.ReadProcessMemory(
                Handle,
                Target_Pointer_to_Address(Target),
                --  Target Address to read.
                Buff'address,
                --  Destination reading buffer.
                Integer_to_Unsigned_long(Length),
                --  Number of Bytes to read.
                null);
    if integer(ReadOk) = 0 then
      return null_string(Length);
--      errorAPI.Report_Error ("ReadProcessMemory");
    end if;
    return Buff;
  end Read_Process_Memory_Ex;

  --------------------------
  -- Write_Process_Memory --
  --------------------------

  procedure Write_Process_Memory(Handle: in Win32.Winnt.HANDLE;
                                 Target: in Address;
                                 Value:  in String) is
    WriteOk : Win32.BOOL;

    type buffering is new string(1..Value'Last);
    type pBuffer is access all buffering; --p is from "pointer".
    Buff: aliased buffering := buffering(Value);
    pBuff: constant pBuffer:= Buff'access;
    function pBuffer_to_Address is new
      Ada.Unchecked_Conversion
        (source => pBuffer,
         target => System.Address);

    function Target_Pointer_to_Address is new
      Ada.Unchecked_Conversion
        (source => Address,
         target => System.Address);

    function Integer_to_Unsigned_long is new
      Ada.Unchecked_Conversion
        (source => Integer,
         target => Interfaces.C.unsigned_long);
  begin
    WriteOk := Win32.Winbase.WriteProcessMemory(
                 Handle,
                 Target_Pointer_to_Address(Target),
                 --  Target Address to write.
                 pBuffer_to_Address(pBuff),
                 --  Source of the reading pointer.
                 Integer_to_Unsigned_long(Value'Last),
                 --  Number of Bytes to write.
                 null);
    if integer(WriteOk) = 0
      then Report_Error_Thr("WriteProcessMemory", Get_Last_Error);
    end if;
  end Write_Process_Memory;

  ---------------------
  -- Get_System_Info --
  ---------------------

  function Get_System_Info return SYSTEM_INFO is
    Info : aliased SYSTEM_INFO;

    function addr_to_lpsysinfo is new
      Ada.Unchecked_Conversion(System.Address, Win32.Winbase.LPSYSTEM_INFO);
  begin
    Win32.Winbase.GetSystemInfo(addr_to_lpsysinfo(Info'Address));
    return Info;
  end Get_System_Info;

  ----------------------
  -- Virtual_Query_Ex --
  ----------------------

  function Virtual_Query_Ex (HProc : in Handle; Addr : in Address)
                             return MEMORY_BASIC_INFORMATION is
    use Interfaces.C;
    Info : aliased MEMORY_BASIC_INFORMATION;

    function addr_to_lpbmeminfo is new
      Ada.Unchecked_Conversion
        (System.Address, Win32.Winnt.PMEMORY_BASIC_INFORMATION);

    n : integer;
  begin
    n := Integer(Win32.Winbase.VirtualQueryEx
                 (HProc, Addr, addr_to_lpbmeminfo(Info'address),
                  MEMORY_BASIC_INFORMATION'Size / 8));
    if integer(n) = 0 then
      Report_Error_Thr("VirtualQueryEx_Noreturn", Get_Last_Error);
    elsif integer(n) /= MEMORY_BASIC_INFORMATION'Size / 8 then
      Report_Error_Thr("VirtualQueryEx_Shortreturn", Get_Last_Error);
    end if;
    return Info;
  end Virtual_Query_Ex;

  -----------------------------
  -- Get_Process_Memory_Info --
  -----------------------------

  function Get_Process_Memory_Info (HProc: in Handle) return PROCESS_MEMORY_COUNTERS is
    use Interfaces.C;
    Success  : Win32.BOOL;
    Counters : aliased PROCESS_MEMORY_COUNTERS;
  begin
    Success := GetProcessMemoryInfo(
                 HProc,
                 Counters'Address,
                 PROCESS_MEMORY_COUNTERS'Size / 8);
    if integer(Success) = 0 then
      Report_Error_Thr("GetProcessMemoryInfo", Get_Last_Error);
    end if;
    Return Counters;
  end Get_Process_Memory_Info;

  --------------------------
  -- Global_Memory_Status --
  --------------------------

  function Global_Memory_Status return MEMORYSTATUS is
    Memstatus : aliased Win32.Winbase.MEMORYSTATUS;

    function address_to_pmemstatus is new
      Ada.Unchecked_Conversion(Address, Win32.winbase.LPMEMORYSTATUS);
  begin
    Win32.Winbase.GlobalMemoryStatus(address_to_pmemstatus(Memstatus'address));
    return MEMORYSTATUS(Memstatus);
  end Global_Memory_Status;

end  win32api_interface.memory;

